(* Yoann Padioleau
 *
 * Copyright (C) 2021 r2c
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * version 2.1 as published by the Free Software Foundation, with the
 * special exception on linking described in file license.txt.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
 * license.txt for more details.
 *)
open Common
module H = AST_generic_helpers
open Ast_cpp
open OCaml (* for the map_of_xxx *)

module PI = Parse_info
module G = AST_generic

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(* Ast_cpp to AST_generic.
 *
 * See ast_generic.ml for more information.
 *
 * TODO: copy code from ast_c_build.ml, like the ifdef_skipper
 * TODO: copy code from c_to_generic.ml, like DeRef unsugaring
 *)

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

type env = unit

let error = AST_generic.error

let _id x = x

let map_either _env f g x =
  match x with
  | Left x -> Left (f x)
  | Right x -> Right (g x)

let todo _env _x = failwith "TODO"

(* alt: change AST_generic.ml instead to take more expr option? *)
let expr_option t eopt =
  match eopt with
  | Some e -> e
  | None -> G.L (G.Unit t) |> G.e

let _name_option t nopt =
  match nopt with
  | Some n -> n
  | None ->
      (* TODO? gensym? *)
      let fake_id = ("_ANON", t) in
      H.name_of_id fake_id

let distribute_access (xs : (G.field, G.attribute) either list) : G.field list =
  let rec aux attr_opt xs =
    match xs with
    | [] -> []
    | x :: xs -> (
        match x with
        | Left fld ->
            (* TODO: use attr_opt to modify fld if it's a def
             * and add the access modifier *)
            fld :: aux attr_opt xs
        | Right attr -> aux (Some attr) xs)
  in
  aux None xs

(* crazy https://en.cppreference.com/w/cpp/language/template_parameters *)
let parameter_to_type_parameter (_p : G.parameter) : G.type_parameter =
  failwith "TODO2"

let def_or_dir_either_to_stmt = function
  | Left dir -> G.DirectiveStmt dir |> G.s
  | Right def -> G.DefStmt def |> G.s

let any_of_either_type_expr = function
  | Left t -> G.T t
  | Right e -> G.E e

let arg_of_either_expr_type = function
  | Left e -> G.Arg e
  | Right t -> G.ArgType t

let map_def_in_stmt f st =
  match st.G.s with
  | DefStmt (ent, def) ->
      let ent, def = f (ent, def) in
      { st with s = DefStmt (ent, def) }
  (* less: raise an error? *)
  | _ -> st

(*****************************************************************************)
(* Conversions *)
(*****************************************************************************)

(* generated by ocamltarzan with: camlp4o -o /tmp/yyy.ml -I pa/ pa_type_conv.cmo pa_map_todo.cmo  pr_o.cmo /tmp/xxx.ml  *)

let map_tok _env v = v

let map_wrap env _of_a (v1, v2) =
  let v1 = _of_a v1 and v2 = map_tok env v2 in
  (v1, v2)

let map_paren env _of_a (v1, v2, v3) =
  let v1 = map_tok env v1 and v2 = _of_a v2 and v3 = map_tok env v3 in
  (v1, v2, v3)

let map_paren_skip _env _of_a (_v1, v2, _v3) = _of_a v2

let map_brace env _of_a (v1, v2, v3) =
  let v1 = map_tok env v1 and v2 = _of_a v2 and v3 = map_tok env v3 in
  (v1, v2, v3)

let map_bracket env _of_a (v1, v2, v3) =
  let v1 = map_tok env v1 and v2 = _of_a v2 and v3 = map_tok env v3 in
  (v1, v2, v3)

let map_angle _env _of_a (_v1, v2, _v3) = _of_a v2

let map_angle_keep env _of_a (v1, v2, v3) =
  let v1 = map_tok env v1 and v2 = _of_a v2 and v3 = map_tok env v3 in
  (v1, v2, v3)

let map_sc env v = map_tok env v

let map_todo_category env v : G.todo_kind = map_wrap env map_of_string v

let map_ident env v = map_wrap env map_of_string v

let rec map_name env (v1, v2, v3) : G.name =
  let v1 = map_of_option (map_tok env) v1
  and v2 = map_of_list (map_qualifier env) v2
  and v3 = map_ident_or_op env v3 in
  match (v1, v2, v3) with
  | None, [], (id, None) -> H.name_of_id id
  | _ ->
      G.IdQualified
        {
          G.name_last = v3;
          name_top = v1;
          name_middle = (if v2 = [] then None else Some (QDots v2));
          name_info = G.empty_id_info ();
        }

and map_ident_or_op (env : env) = function
  | IdIdent v1 ->
      let v1 = map_ident env v1 in
      (v1, None)
  | IdTemplateId (v1, v2) ->
      let v1 = map_ident env v1 and v2 = map_template_arguments env v2 in
      (v1, Some v2)
  | IdOperator (v1, v2) ->
      let t1 = map_tok env v1 in
      let _op, t2 = map_wrap env (map_operator env) v2 in
      let id =
        (PI.str_of_info t1 ^ " " ^ PI.str_of_info t2, PI.combine_infos t1 [ t2 ])
      in
      (id, None)
  | IdDestructor (v1, v2) ->
      let t1 = map_tok env v1 and s, t2 = map_ident env v2 in
      let id = (PI.str_of_info t1 ^ s, PI.combine_infos t1 [ t2 ]) in
      (id, None)
  | IdConverter (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_type_ env v2 in
      let ii = Visitor_AST.ii_of_any (G.T v2) in
      let s = v1 :: ii |> List.map PI.str_of_info |> String.concat "" in
      let t = PI.combine_infos v1 ii in
      let id = (s, t) in
      (id, None)

and map_template_arguments env (l, v, r) : G.type_arguments =
  let xs = (map_of_list (map_template_argument env)) v in
  (l, xs, r)

and map_template_argument env v : G.type_argument =
  match v with
  | Left t ->
      let t = map_type_ env t in
      G.TA t
  | Right e ->
      let e = map_expr env e in
      G.TAExpr e

and map_qualifier env = function
  | QClassname v1 ->
      let v1 = map_ident env v1 in
      (v1, None)
  | QTemplateId (v1, v2) ->
      let v1 = map_ident env v1 and v2 = map_template_arguments env v2 in
      (v1, Some v2)

and map_a_class_name env v = map_name env v

and map_a_ident_name env v = map_name env v

and map_type_ env (v1, v2) : G.type_ =
  let v1 = map_type_qualifiers env v1 and v2 = map_typeC env v2 in
  { v2 with t_attrs = v1 }

and map_typeC env x : G.type_ =
  match x with
  | TPrimitive v1 ->
      let v1 = map_wrap env (map_primitive_type env) v1 in
      G.TyBuiltin v1 |> G.t
  | TSized (v1, v2) ->
      let v1 = map_of_list (map_sized_type env) v1
      and v2 = map_of_option (map_type_ env) v2 in
      let allt = v1 @ Common.opt_to_list v2 in
      G.OtherType2
        (("TSized", PI.unsafe_fake_info ""), allt |> List.map (fun t -> G.T t))
      |> G.t
  | TPointer (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_type_ env v2
      and v3 = map_of_list (map_pointer_modifier env) v3 in
      { t = G.TyPointer (v1, v2); t_attrs = v3 }
  | TReference (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_type_ env v2 in
      G.TyRef (v1, v2) |> G.t
  | TRefRef (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_type_ env v2 in
      G.OtherType2 (("&&", v1), [ G.T v2 ]) |> G.t
  | TArray (v1, v2) ->
      let v1 = map_bracket env (map_of_option (map_a_const_expr env)) v1
      and v2 = map_type_ env v2 in
      G.TyArray (v1, v2) |> G.t
  | TFunction v1 ->
      let ps, tret = map_functionType env v1 in
      G.TyFun (ps, tret) |> G.t
  | EnumName (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_a_ident_name env v2 in
      G.OtherType2 (("EnumName", v1), [ G.T (G.TyN v2 |> G.t) ]) |> G.t
  | ClassName (v1, v2) ->
      let (_kind, t), _attrs = map_class_key env v1
      and v2 = map_a_class_name env v2 in
      G.OtherType2 ((PI.str_of_info t, t), [ G.T (G.TyN v2 |> G.t) ]) |> G.t
  | TypeName v1 ->
      let v1 = map_a_ident_name env v1 in
      G.TyN v1 |> G.t
  | TypenameKwd (v1, v2) ->
      let _v1 = map_tok env v1 and v2 = map_type_ env v2 in
      v2
  | EnumDef v1 ->
      let nopt, tdef = map_enum_definition env v1 in
      todo env (nopt, tdef)
  | ClassDef v1 ->
      let nopt, cdef = map_class_definition env v1 in
      todo env (nopt, cdef)
  | TypeOf (v1, v2) ->
      let v1 = map_tok env v1
      and _l, v2, _r =
        map_paren env (map_either env (map_type_ env) (map_expr env)) v2
      in
      let any = any_of_either_type_expr v2 in
      G.OtherType2 (("Typeof", v1), [ any ]) |> G.t
  | TAuto v1 ->
      let v1 = map_tok env v1 in
      G.TyAny v1 |> G.t
  | ParenType v1 ->
      let _l, v1, _r = map_paren env (map_type_ env) v1 in
      v1
  | TypeTodo (v1, v2) ->
      let v1 = map_todo_category env v1
      and v2 = map_of_list (map_type_ env) v2 in
      G.OtherType2 (v1, v2 |> List.map (fun t -> G.T t)) |> G.t

and map_primitive_type _env = function
  | TVoid -> "void"
  | TBool -> "bool"
  | TChar -> "char"
  | TInt -> "int"
  | TFloat -> "float"
  | TDouble -> "double"

and map_sized_type env (kind, t) : G.type_ =
  let t = map_tok env t in
  let s =
    match kind with
    | TSigned -> "signed"
    | TUnsigned -> "unsigned"
    | TShort -> "short"
    | TLong -> "long"
  in
  G.TyBuiltin (s, t) |> G.t

and map_type_qualifiers env v : G.attribute list =
  map_of_list (map_qualifier_wrap env) v

and map_qualifier_wrap _env (qu, t) : G.attribute =
  (* old: (map_wrap env (map_type_qualifier env)) *)
  match qu with
  | Const -> G.attr G.Const t
  | Volatile -> G.attr G.Volatile t
  | Restrict -> G.unhandled_keywordattr ("Restrict", t)
  | Atomic -> G.unhandled_keywordattr ("Atomic", t)
  | Mutable -> G.attr G.Mutable t
  | Constexpr -> G.unhandled_keywordattr ("ConstExpr", t)

and map_expr env x : G.expr =
  match x with
  | N (v1, v2) ->
      let v1 = map_name env v1 and _v2 = map_ident_info env v2 in
      G.N v1 |> G.e
  | C v1 ->
      let v1 = map_constant env v1 in
      G.L v1 |> G.e
  | IdSpecial v1 ->
      let v1 = map_wrap env (map_special env) v1 in
      G.IdSpecial v1 |> G.e
  | Call (v1, v2) ->
      let v1 = map_expr env v1
      and v2 = map_paren env (map_of_list (map_argument env)) v2 in
      G.Call (v1, v2) |> G.e
  | CondExpr (v1, v2, v3, v4, v5) ->
      let v1 = map_expr env v1
      and _v2 = map_tok env v2
      and ethen = expr_option v2 (map_of_option (map_expr env) v3)
      and _v4 = map_tok env v4
      and v5 = map_expr env v5 in
      G.Conditional (v1, ethen, v5) |> G.e
  | Sequence (v1, v2, v3) ->
      let v1 = map_expr env v1
      and _v2 = map_tok env v2
      and v3 = map_expr env v3 in
      G.Seq [ v1; v3 ] |> G.e
  | Assign (v1, v2, v3) -> (
      let v1 = map_a_lhs env v1
      and v2 = map_assignOp env v2
      and v3 = map_expr env v3 in
      match v2 with
      | Left teq -> G.Assign (v1, teq, v3) |> G.e
      | Right op -> G.AssignOp (v1, op, v3) |> G.e)
  | Prefix (v1, v2) ->
      let op, t = map_wrap env (map_fixOp env) v1 and v2 = map_expr env v2 in
      G.special (G.IncrDecr (op, G.Prefix), t) [ v2 ]
  | Postfix (v1, v2) ->
      let v1 = map_expr env v1 and op, t = map_wrap env (map_fixOp env) v2 in
      G.special (G.IncrDecr (op, G.Postfix), t) [ v1 ]
  | Unary (v1, v2) -> (
      let either, t = map_wrap env (map_unaryOp env) v1
      and v2 = map_expr env v2 in
      match either with
      | Left op -> G.opcall (op, t) [ v2 ]
      | Right f -> f t v2)
  | Binary (v1, v2, v3) ->
      let v1 = map_expr env v1
      and v2 = map_wrap env (map_binaryOp env) v2
      and v3 = map_expr env v3 in
      G.opcall v2 [ v1; v3 ]
  | ArrayAccess (v1, v2) ->
      let v1 = map_expr env v1 and v2 = map_bracket env (map_expr env) v2 in
      G.ArrayAccess (v1, v2) |> G.e
  | DotAccess (v1, v2, v3) -> (
      let v1 = map_expr env v1
      and either, tdot = map_wrap env (map_dotOp env) v2
      and v3 = map_name env v3 in
      match either with
      | Dot -> G.DotAccess (v1, tdot, G.EN v3) |> G.e
      | Arrow ->
          let v1 = G.DeRef (tdot, v1) |> G.e in
          G.DotAccess (v1, tdot, G.EN v3) |> G.e)
  | DotStarAccess (v1, v2, v3) -> (
      let v1 = map_expr env v1
      and either, tdot = map_wrap env (map_dotOp env) v2
      and v3 = map_expr env v3 in
      let e = G.DeRef (tdot, v3) |> G.e in
      match either with
      | Dot -> G.DotAccess (v1, tdot, G.EDynamic e) |> G.e
      | Arrow ->
          let v1 = G.DeRef (tdot, v1) |> G.e in
          G.DotAccess (v1, tdot, G.EDynamic e) |> G.e)
  | SizeOf (v1, v2) ->
      let v1 = map_tok env v1
      and v2 =
        map_either env (map_expr env) (map_paren_skip env (map_type_ env)) v2
      in
      let arg = arg_of_either_expr_type v2 in
      let special = G.IdSpecial (G.Sizeof, v1) |> G.e in
      G.Call (special, G.fake_bracket [ arg ]) |> G.e
  | Cast (v1, v2) ->
      let l, t, _r = map_paren env (map_type_ env) v1
      and v2 = map_expr env v2 in
      G.Cast (t, l, v2) |> G.e
  | StatementExpr v1 ->
      let l, (_, xs, _), r = map_paren env (map_compound env) v1 in
      let st = G.Block (l, xs, r) |> G.s in
      G.stmt_to_expr st
  | GccConstructor (v1, v2) ->
      let lpar, t, _rpar = map_paren env (map_type_ env) v1
      and lbrace, xs, rbrace =
        map_brace env (map_of_list (map_initialiser env)) v2
      in
      let special = G.IdSpecial (G.New, lpar) |> G.e in
      G.Call (special, (lbrace, G.ArgType t :: (xs |> List.map G.arg), rbrace))
      |> G.e
  | ConstructedObject (v1, v2) ->
      let t = map_type_ env v1 and l, args, r = map_obj_init env v2 in
      let special = G.IdSpecial (G.New, PI.fake_info l "new") |> G.e in
      G.Call (special, (l, G.ArgType t :: args, r)) |> G.e
  | TypeId (v1, v2) ->
      let v1 = map_tok env v1
      and _l, either, _r =
        map_paren env (map_either env (map_type_ env) (map_expr env)) v2
      in
      let any = any_of_either_type_expr either in
      G.OtherExpr (G.OE_Todo, [ G.TodoK ("TypeId", v1); any ]) |> G.e
  | CplusplusCast (v1, v2, v3) ->
      let optodo, t = map_wrap env (map_cast_operator env) v1
      and langle, typ, _rangle = map_angle_keep env (map_type_ env) v2
      and _lpar, e, rpar = map_paren env (map_expr env) v3 in
      let ecall = G.OtherExpr (G.OE_Todo, [ G.TodoK (optodo, t) ]) |> G.e in
      G.Call (ecall, (langle, [ G.ArgType typ; G.Arg e ], rpar)) |> G.e
  | New (v1, v2, v3, v4, v5) ->
      let _topqualifierTODO = map_of_option (map_tok env) v1
      and v2 = map_tok env v2
      and _placementTODO =
        map_of_option (map_paren env (map_of_list (map_argument env))) v3
      and v4 = map_type_ env v4
      and v5 = map_of_option (map_obj_init env) v5 in
      let special = G.IdSpecial (G.New, v2) |> G.e in
      let l, args, r =
        match v5 with
        | None -> G.fake_bracket [ G.ArgType v4 ]
        | Some (l, args, r) -> (l, G.ArgType v4 :: args, r)
      in
      G.Call (special, (l, args, r)) |> G.e
  | Delete (v1, v2, v3, v4) ->
      let _topqualifierTODO = map_of_option (map_tok env) v1
      and v2 = map_tok env v2
      and v3 = map_of_option (map_bracket env map_of_unit) v3
      and v4 = map_expr env v4 in
      let categ =
        match v3 with
        | None -> G.TodoK ("Delete", v2)
        | Some (_l, (), _r) -> G.TodoK ("Delete[]", v2)
      in
      G.OtherExpr (G.OE_Todo, [ categ; G.E v4 ]) |> G.e
  | Throw (v1, v2) ->
      let v1 = map_tok env v1
      and v2 = expr_option v1 (map_of_option (map_expr env) v2) in
      let st = G.Throw (v1, v2, G.sc) |> G.s in
      G.stmt_to_expr st
  | Lambda v1 ->
      let v1 = map_lambda_definition env v1 in
      G.Lambda v1 |> G.e
  | ParamPackExpansion (v1, v2) ->
      let v1 = map_expr env v1 and v2 = map_tok env v2 in
      G.OtherExpr (G.OE_Todo, [ G.TodoK ("Pack", v2); G.E v1 ]) |> G.e
  | ParenExpr v1 ->
      let _l, v1, _r = map_paren env (map_expr env) v1 in
      v1
  | Ellipsis v1 ->
      let v1 = map_tok env v1 in
      G.Ellipsis v1 |> G.e
  | DeepEllipsis v1 ->
      let v1 = map_bracket env (map_expr env) v1 in
      G.DeepEllipsis v1 |> G.e
  | TypedMetavar (v1, v2) ->
      let v1 = map_ident env v1 and v2 = map_type_ env v2 in
      G.TypedMetavar (v1, G.fake ":", v2) |> G.e
  | ExprTodo (v1, v2) ->
      let v1 = map_todo_category env v1
      and v2 = map_of_list (map_expr env) v2 in
      G.OtherExpr (G.OE_Todo, G.TodoK v1 :: (v2 |> List.map (fun e -> G.E e)))
      |> G.e

and map_ident_info _env { i_scope = _v_i_scope } = ()

and map_special _env = function
  | This -> G.This
  | Defined -> G.Defined

and map_argument env x : G.argument =
  match x with
  | Arg v1 ->
      let v1 = map_expr env v1 in
      G.Arg v1
  | ArgType v1 ->
      let v1 = map_type_ env v1 in
      G.ArgType v1
  | ArgAction v1 ->
      let v1 = map_action_macro env v1 in
      G.OtherArg (("ArgMacro", G.fake ""), v1)
  | ArgInits v1 ->
      let l, xs, r = map_brace env (map_of_list (map_initialiser env)) v1 in
      G.Arg (G.Container (G.Dict, (l, xs, r)) |> G.e)

and map_action_macro env x : G.any list =
  match x with
  | ActMisc v1 ->
      let v1 = map_of_list (map_tok env) v1 in
      v1 |> List.map (fun t -> G.Tk t)

and map_constant env x : G.literal =
  match x with
  | Int v1 ->
      let v1 = map_wrap env (map_of_option map_of_int) v1 in
      G.Int v1
  | Float v1 ->
      let v1 = map_wrap env (map_of_option map_of_float) v1 in
      G.Float v1
  | Char v1 ->
      let v1 = map_wrap env map_of_string v1 in
      G.Char v1
  | String v1 ->
      let v1 = map_wrap env map_of_string v1 in
      G.String v1
  | MultiString v1 ->
      let v1 = map_of_list (map_wrap env map_of_string) v1 in
      let s = v1 |> List.map fst |> String.concat "" in
      let t =
        match v1 |> List.map snd with
        | [] -> raise Impossible
        | x :: xs -> PI.combine_infos x xs
      in
      G.String (s, t)
  | Bool v1 ->
      let v1 = map_wrap env map_of_bool v1 in
      G.Bool v1
  | Nullptr v1 ->
      let v1 = map_tok env v1 in
      G.Null v1

and map_unaryOp _env = function
  | UnPlus -> Left G.Plus
  | UnMinus -> Left G.Minus
  | Tilde -> Left G.BitNot
  | Not -> Left G.Not
  | GetRef -> Right (fun tok e -> G.Ref (tok, e) |> G.e)
  | DeRef -> Right (fun tok e -> G.DeRef (tok, e) |> G.e)
  | GetRefLabel ->
      Right
        (fun tok e ->
          G.OtherExpr (G.OE_GetRefLabel, [ G.Tk tok; G.E e ]) |> G.e)

and map_assignOp env = function
  | SimpleAssign v1 ->
      let v1 = map_tok env v1 in
      Left v1
  | OpAssign v1 ->
      let v1 = map_wrap env (map_arithOp env) v1 in
      Right v1

and map_fixOp _env = function
  | Dec -> G.Decr
  | Inc -> G.Incr

and map_dotOp _env = function
  | Dot -> Dot
  | Arrow -> Arrow

and map_binaryOp env x : G.operator =
  match x with
  | Arith v1 ->
      let v1 = map_arithOp env v1 in
      v1
  | Logical v1 ->
      let v1 = map_logicalOp env v1 in
      v1

and map_arithOp _env = function
  | Plus -> G.Plus
  | Minus -> G.Minus
  | Mul -> G.Mult
  | Div -> G.Div
  | Mod -> G.Mod
  | DecLeft -> G.LSL
  | DecRight -> G.LSR
  | And -> G.BitAnd
  | Or -> G.BitOr
  | Xor -> G.BitXor

and map_logicalOp _env = function
  | Inf -> G.Lt
  | Sup -> G.Gt
  | InfEq -> G.LtE
  | SupEq -> G.GtE
  | Eq -> G.Eq
  | NotEq -> G.NotEq
  | AndLog -> G.And
  | OrLog -> G.Or

and map_ptrOp _env = function
  | PtrStarOp -> PtrStarOp
  | PtrOp -> PtrOp

and map_allocOp _env = function
  | NewOp -> NewOp
  | DeleteOp -> DeleteOp
  | NewArrayOp -> NewArrayOp
  | DeleteArrayOp -> DeleteArrayOp

and map_accessop _env = function
  | ParenOp -> ParenOp
  | ArrayOp -> ArrayOp

and map_operator (env : env) = function
  | BinaryOp v1 ->
      let _v1 = map_binaryOp env v1 in
      ()
  | AssignOp v1 ->
      let _v1 = map_assignOp env v1 in
      ()
  | FixOp v1 ->
      let _v1 = map_fixOp env v1 in
      ()
  | PtrOpOp v1 ->
      let _v1 = map_ptrOp env v1 in
      ()
  | AccessOp v1 ->
      let _v1 = map_accessop env v1 in
      ()
  | AllocOp v1 ->
      let _v1 = map_allocOp env v1 in
      ()
  | UnaryTildeOp -> ()
  | UnaryNotOp -> ()
  | CommaOp -> ()

and map_cast_operator _env = function
  | Static_cast -> "Static_cast"
  | Dynamic_cast -> "Dynamic_cast"
  | Const_cast -> "Const_cast"
  | Reinterpret_cast -> "Reinterpret_cast"

and map_a_const_expr env v = map_expr env v

and map_a_lhs env v = map_expr env v

and map_stmt env x : G.stmt =
  match x with
  | Compound v1 ->
      let v1 = map_compound env v1 in
      G.Block v1 |> G.s
  | ExprStmt v1 ->
      let eopt, sc = map_expr_stmt env v1 in
      let e = expr_option sc eopt in
      G.ExprStmt (e, sc) |> G.s
  | MacroStmt v1 ->
      let v1 = map_tok env v1 in
      G.OtherStmt (G.OS_Todo, [ G.TodoK ("MacroStmt", v1) ]) |> G.s
  | If (v1, v2, v3, v4, v5) ->
      let v1 = map_tok env v1
      and _v2TODO = map_of_option (map_tok env) v2 (* constexpr *)
      and _, cond, _ = map_paren env (map_condition_clause env) v3
      and v4 = map_stmt env v4
      and v5 =
        map_of_option
          (fun (v1, v2) ->
            let _else = map_tok env v1 and v2 = map_stmt env v2 in
            v2)
          v5
      in
      G.If (v1, cond, v4, v5) |> G.s
  | Switch (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_paren_skip env (map_condition_clause env) v2
      and v3 = map_cases env v1 v3 in
      G.Switch (v1, Some v2, v3) |> G.s
  | While (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _, cond, _ = map_paren env (map_condition_clause env) v2
      and v3 = map_stmt env v3 in
      G.While (v1, cond, v3) |> G.s
  | DoWhile (v1, v2, v3, v4, v5) ->
      let v1 = map_tok env v1
      and v2 = map_stmt env v2
      and _v3 = map_tok env v3
      and _, cond, _ = map_paren env (map_expr env) v4
      and _v5 = map_sc env v5 in
      G.DoWhile (v1, v2, cond) |> G.s
  | For (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _, header, _ = map_paren env (map_for_header env) v2
      and v3 = map_stmt env v3 in
      G.For (v1, header, v3) |> G.s
  | MacroIteration (v1, v2, v3) ->
      let v1 = map_ident env v1
      and v2 = map_paren_skip env (map_of_list (map_argument env)) v2
      and v3 = map_stmt env v3 in
      let anys = [ G.I v1; G.Args v2 ] in
      G.OtherStmtWithStmt (G.OSWS_Iterator, anys, v3) |> G.s
  | Jump (v1, v2) ->
      let v1 = map_jump env v1 and v2 = map_sc env v2 in
      v1 v2
  | Label (v1, v2, v3) ->
      let v1 = map_a_label env v1
      and _v2 = map_tok env v2
      and v3 = map_stmt env v3 in
      G.Label (v1, v3) |> G.s
  (* should be handled in map_cases *)
  | Case _
  | CaseRange _
  | Default _ ->
      let cases, xs = convert_case env x in
      let anys = cases |> List.map (fun cs -> G.Cs cs) in
      let sts = map_of_list (map_stmt_or_decl env) xs |> List.flatten in
      let st = G.stmt1 sts in
      G.OtherStmtWithStmt (OSWS_Todo, anys, st) |> G.s
  | Try (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_compound env v2
      and v3 = map_of_list (map_handler env) v3 in
      G.Try (v1, G.Block v2 |> G.s, v3, None) |> G.s
  | StmtTodo (v1, v2) ->
      let v1 = map_todo_category env v1
      and v2 = map_of_list (map_stmt env) v2 in
      let st = G.Block (G.fake_bracket v2) |> G.s in
      G.OtherStmtWithStmt (OSWS_Todo, [ G.TodoK v1 ], st) |> G.s

(* similar to Ast_c_build.cases()
 * TODO: CaseEllipsis?
 *)
and map_cases env tk st : G.case_and_body list =
  match st with
  | Compound (_l, xs, _r) ->
      (* note that parser_cpp.mly and tree-sitter-cpp currently parse
       * differently 'case 1: i++; break'. In pfff the case accepts a
       * single stmt after, in tree-sitter a list of stmt (which is better)
       * so here for pfff we need to put back 'break' under the case.
       *)
      let rec aux xs =
        match xs with
        | [] -> []
        | x :: xs -> (
            match x with
            (* in tree-sitter-cpp, some Case have no body because they
             * are followed by another Case that will have them
             *)
            | X
                (S
                  (( Case (t, _, _, [])
                   | CaseRange (t, _, _, _, _, [])
                   | Default (t, _, []) ) as case1)) ->
                let case_repack, rest =
                  repack_case_with_following_cases env t case1 xs
                in
                aux (X (S case_repack) :: rest)
            | X (S ((Case _ | CaseRange _ | Default _) as case1)) ->
                (* in pfff some statements may be without a leading case,
                 * so we need to repack them *)
                let before_next_case, rest =
                  xs
                  |> Common.span (function
                       | X (S (Case _ | CaseRange _ | Default _)) -> false
                       | _ -> true)
                in
                let case_repack =
                  repack_case_with_following_stmts env case1 before_next_case
                in
                let cases, xs = convert_case env case_repack in
                let sts =
                  map_of_list (map_stmt_or_decl env) xs |> List.flatten
                in
                let st = G.stmt1 sts in
                G.CasesAndBody (cases, st) :: aux rest
            | _ ->
                (* non Case, weird, skip for now *)
                let cases = [ G.OtherCase (("StmtNotCase", tk), []) ] in
                let sts = map_sequencable env (map_stmt_or_decl env) x in
                let st = G.stmt1 sts in
                G.CasesAndBody (cases, st) :: aux xs)
      in
      aux xs
  | _ ->
      (* degenerated case *)
      let cases = [ G.OtherCase (("NoBlockInSwitch", tk), []) ] in
      let st = map_stmt env st in
      [ G.CasesAndBody (cases, st) ]

(* needed only for tree-sitter *)
and repack_case_with_following_cases env tk (st_case_empty_body : stmt) xs =
  match xs with
  | [] -> error tk "empty case body, impossible"
  | x :: xs -> (
      let new_case_body_stmt, rest =
        match x with
        | X
            (S
              (( Case (t, _, _, [])
               | CaseRange (t, _, _, _, _, [])
               | Default (t, _, []) ) as case1)) ->
            let case_repack, rest =
              repack_case_with_following_cases env t case1 xs
            in
            (case_repack, rest)
        | X
            (S
              (( Case (_, _, _, _)
               | CaseRange (_, _, _, _, _, _)
               | Default (_, _, _) ) as case1)) ->
            (case1, xs)
        | _ -> error tk "could not find a case"
      in
      match st_case_empty_body with
      | Case (v1, v2, v3, []) ->
          (Case (v1, v2, v3, [ S new_case_body_stmt ]), rest)
      | CaseRange (v1, v2, v3, v4, v5, []) ->
          (CaseRange (v1, v2, v3, v4, v5, [ S new_case_body_stmt ]), rest)
      | Default (v1, v2, []) ->
          (Default (v1, v2, [ S new_case_body_stmt ]), rest)
      | _ -> raise Impossible)

(* needed only for pfff *)
and repack_case_with_following_stmts _env (st_case_only : stmt) sts : stmt =
  let sts =
    sts
    |> Common.map_filter (function
         | X x -> Some x
         (* TODO? skipped directive code? *)
         | _ -> None)
  in
  match st_case_only with
  | Case (v1, v2, v3, v4) ->
      let v4 = v4 @ sts in
      Case (v1, v2, v3, v4)
  | CaseRange (v1, v2, v3, v4, v5, v6) ->
      let v6 = v6 @ sts in
      CaseRange (v1, v2, v3, v4, v5, v6)
  | Default (v1, v2, v3) ->
      let v3 = v3 @ sts in
      Default (v1, v2, v3)
  | _ -> raise Impossible

and map_case_body env tk case_body : G.case list * stmt_or_decl list =
  match case_body with
  | [] -> error tk "empty case body, impossible"
  | x :: xs -> (
      match x with
      (* merge all the cases together *)
      | S ((Case _ | CaseRange _ | Default _) as st1) ->
          let cases, rest = convert_case env st1 in
          (cases, rest @ xs)
      | _ ->
          let cases = [] in
          let rest = x :: xs in
          (cases, rest))

and convert_case env st_case_only : G.case list * stmt_or_decl list =
  match st_case_only with
  | Case (v1, v2, v3, v4) ->
      let v1 = map_tok env v1
      and v2 = map_expr env v2
      and _v3 = map_tok env v3
      and other_cases, sts = map_case_body env v1 v4 in
      let case1 = G.Case (v1, H.expr_to_pattern v2) in
      (case1 :: other_cases, sts)
  | CaseRange (v1, v2, v3, v4, v5, v6) ->
      let v1 = map_tok env v1
      and v2 = map_expr env v2
      and _v3 = map_tok env v3
      and v4 = map_expr env v4
      and _v5 = map_tok env v5
      and other_cases, sts = map_case_body env v1 v6 in
      let case1 = G.OtherCase (("CaseRange", v1), [ G.E v2; G.E v4 ]) in
      (case1 :: other_cases, sts)
  | Default (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _v2 = map_tok env v2
      and other_cases, sts = map_case_body env v1 v3 in
      let case1 = G.Default v1 in
      (case1 :: other_cases, sts)
  | _ -> raise Impossible

and map_expr_stmt env (v1, v2) =
  let v1 = map_of_option (map_expr env) v1 and v2 = map_sc env v2 in
  (v1, v2)

and map_condition_clause env x : G.condition =
  match x with
  | CondClassic v1 ->
      let v1 = map_expr env v1 in
      v1
  | CondDecl (v1, v2) ->
      let _v1TODO = map_vars_decl env v1 and v2 = map_expr env v2 in
      v2
  | CondStmt (v1, v2) ->
      let _v1TODO = map_expr_stmt env v1 and v2 = map_expr env v2 in
      v2
  | CondOneDecl v1 ->
      let v1 = map_var_decl env v1 in
      todo env v1

and map_for_header env = function
  | ForClassic (v1, v2, v3) ->
      let v1 = map_a_expr_or_vars env v1
      and v2 = map_of_option (map_expr env) v2
      and v3 = map_of_option (map_expr env) v3 in
      G.ForClassic (v1, v2, v3)
  | ForRange (v1, v2, v3) ->
      let ent, vardef = map_var_decl env v1
      and _v2 = map_tok env v2
      and v3 = map_initialiser env v3 in
      (* less: or ForEach? *)
      G.ForIn ([ G.ForInitVar (ent, vardef) ], [ v3 ])

and map_a_expr_or_vars env v =
  match v with
  | Left (Some e, _sc) ->
      let e = map_expr env e in
      [ ForInitExpr e ]
  | Left (None, _) -> []
  | Right xs ->
      let xs = map_vars_decl env xs in
      xs
      |> List.map (fun onedecl ->
             let ent, vardef = todo env onedecl in
             G.ForInitVar (ent, vardef))

and map_a_label env v = map_wrap env map_of_string v

and map_jump env = function
  | Goto (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_a_label env v2 in
      fun sc -> G.Goto (v1, v2, sc) |> G.s
  | Continue v1 ->
      let v1 = map_tok env v1 in
      fun sc -> G.Continue (v1, G.LNone, sc) |> G.s
  | Break v1 ->
      let v1 = map_tok env v1 in
      fun sc -> G.Break (v1, G.LNone, sc) |> G.s
  | Return (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_of_option (map_argument env) v2 in
      let v2 = Common.map_opt H.argument_to_expr v2 in
      fun sc -> G.Return (v1, v2, sc) |> G.s
  | GotoComputed (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _v2 = map_tok env v2
      and v3 = map_expr env v3 in
      (* less: could change G.Goto to take a label instead of label_ident? *)
      fun _sc ->
        G.OtherStmt (G.OS_Todo, [ G.TodoK ("GotoComputed", v1); G.E v3 ]) |> G.s

and map_handler env (v1, v2, v3) : G.catch =
  let v1 = map_tok env v1
  and _, xs, _ =
    map_paren env (map_of_list (map_exception_declaration v1 env)) v2
  and v3 = map_compound env v3 in
  let pat : G.catch_exn = todo env xs in
  (v1, pat, G.Block v3 |> G.s)

and map_exception_declaration tok env x : G.catch_exn =
  match x with
  | ExnDecl v1 -> (
      let v1 = map_parameter env v1 in
      match H.parameter_to_catch_exn_opt v1 with
      | Some x -> x
      | None ->
          error tok "could not convert a parameter into a catch exn handler")

and map_stmt_or_decl env x : G.stmt list =
  match x with
  | S v1 ->
      let v1 = map_stmt env v1 in
      [ v1 ]
  | D v1 ->
      let v1 = map_decl env v1 in
      v1

and map_compound env (l, v, r) : G.stmt list bracket =
  let xs = map_of_list (map_sequencable env (map_stmt_or_decl env)) v in
  (l, List.flatten xs, r)

and map_declarations env (l, v, r) : G.stmt list bracket =
  let xs = map_of_list (map_sequencable env (map_stmt_or_decl env)) v in
  (l, List.flatten xs, r)

and map_entity env { name = v_name; specs = v_specs } : G.entity =
  let v_specs = map_of_list (map_specifier env) v_specs in
  let v_name = map_name env v_name in
  { G.name = G.EN v_name; attrs = v_specs; tparams = [] }

and map_decl env x : G.stmt list =
  match x with
  | DeclList v1 ->
      let v1 = map_vars_decl env v1 in
      v1 |> List.map (fun def -> G.DefStmt def |> G.s)
  | UsingDecl v1 ->
      let v1 = map_using env v1 in
      [ v1 ]
  | NamespaceAlias (v1, v2, v3, v4, v5) ->
      let v1 = map_tok env v1
      and v2 = map_ident env v2
      and _v3 = map_tok env v3
      and v4 = map_name env v4
      and _v5 = map_sc env v5 in
      let dots = H.dotted_ident_of_name v4 in
      let dir =
        G.ImportAs (v1, G.DottedName dots, Some (v2, G.empty_id_info ())) |> G.d
      in
      [ G.DirectiveStmt dir |> G.s ]
  | Asm (v1, v2, v3, v4) ->
      let v1 = map_tok env v1
      and _volatileTODO = map_of_option (map_tok env) v2
      and v3 = map_paren_skip env (map_asmbody env) v3
      and v4 = map_sc env v4 in
      let anys = v3 in
      [
        G.OtherStmt (OS_Asm, [ G.TodoK ("Asm", v1) ] @ anys @ [ G.Tk v4 ])
        |> G.s;
      ]
  | Func v1 ->
      let v1 = map_func_definition env v1 in
      [ G.DefStmt v1 |> G.s ]
  | TemplateDecl (v1, v2, v3) ->
      let _v1 = map_tok env v1
      and v2 = map_template_parameters env v2
      and v3 = map_decl env v3 in
      v3
      |> List.map
           (map_def_in_stmt (fun (ent, def) -> ({ ent with tparams = v2 }, def)))
  | TemplateInstanciation (v1, v2, v3) ->
      let v1 = map_tok env v1
      and ent, vardef = map_var_decl env v2
      and v3 = map_sc env v3 in
      todo env (v1, ent, vardef, v3)
  | ExternDecl (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _v2TODO = map_wrap env map_of_string v2
      and v3 = map_decl env v3 in
      v3
      |> List.map
           (map_def_in_stmt (fun (ent, def) ->
                let extern = G.attr Extern v1 in
                ({ ent with attrs = extern :: ent.attrs }, def)))
  | ExternList (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _v2TODO = map_wrap env map_of_string v2
      and _l, v3, _r = map_declarations env v3 in
      v3
      |> List.map
           (map_def_in_stmt (fun (ent, def) ->
                let extern = G.attr Extern v1 in
                ({ ent with attrs = extern :: ent.attrs }, def)))
  | Namespace (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_of_option (map_ident env) v2
      and _l, v3, r = map_declarations env v3 in
      let dir1 = G.Package (v1, opt_to_list v2) |> G.d in
      let dir2 = G.PackageEnd r |> G.d in
      [ G.DirectiveStmt dir1 |> G.s ] @ v3 @ [ G.DirectiveStmt dir2 |> G.s ]
  | StaticAssert (v1, v2) ->
      let v1 = map_tok env v1
      and v2 = map_paren env (map_of_list (map_argument env)) v2 in
      [ G.Assert (v1, v2, G.sc) |> G.s ]
  | EmptyDef v1 ->
      let v1 = map_sc env v1 in
      [ G.emptystmt v1 ]
  | NotParsedCorrectly v1 ->
      let v1 = map_of_list (map_tok env) v1 in
      [ G.OtherStmt (G.OS_Todo, v1 |> List.map (fun tk -> G.Tk tk)) |> G.s ]
  | DeclTodo v1 ->
      let v1 = map_todo_category env v1 in
      [ G.OtherStmt (G.OS_Todo, [ G.TodoK v1 ]) |> G.s ]

and map_vars_decl env (v1, v2) : G.definition list =
  let v1 = map_of_list (map_onedecl env) v1 and _v2 = map_sc env v2 in
  v1

and map_asmbody env (v1, v2) : G.any list =
  let _v1 = map_of_list (map_wrap env map_of_string) v1
  and v2 = map_of_list (map_colon env) v2 in
  v2 |> List.flatten

and map_colon env = function
  | Colon (v1, v2) ->
      let _v1 = map_tok env v1 and v2 = map_of_list (map_colon_option env) v2 in
      v2 |> List.flatten

and map_colon_option env = function
  | ColonExpr (v1, v2) ->
      let _v1 = map_of_list (map_tok env) v1
      and v2 = map_paren_skip env (map_expr env) v2 in
      [ G.E v2 ]
  | ColonMisc v1 ->
      let _v1 = map_of_list (map_tok env) v1 in
      []

and map_onedecl env x : G.definition =
  match x with
  | EmptyDecl t ->
      let t = map_type_ env t in
      todo env t
  | TypedefDecl (tk, ty, id) ->
      let _tk = map_tok env tk in
      let ty = map_type_ env ty in
      let id = map_ident env id in
      let ent = G.basic_entity id in
      (ent, G.TypeDef { G.tbody = G.AliasType ty })
  | V v1 ->
      let ent, vardef = map_var_decl env v1 in
      (ent, G.VarDef vardef)
  | StructuredBinding (v1, v2, v3) ->
      let v1 = map_type_ env v1 in
      let v2 = map_bracket env (map_of_list (map_ident env)) v2 in
      let v3 = map_init env v3 in
      todo env (v1, v2, v3)
  | BitField (v1, v2, v3, v4) ->
      let v1 = map_of_option (map_ident env) v1
      and v2 = map_tok env v2
      and v3 = map_type_ env v3
      and v4 = map_a_const_expr env v4 in
      todo env (v1, v2, v3, v4)

and map_var_decl env (ent, { v_init = v_v_init; v_type = v_v_type }) =
  let ent = map_entity env ent in
  let v_v_type = map_type_ env v_v_type in
  let v_v_init = map_of_option (map_init env) v_v_init in
  (ent, { G.vtype = Some v_v_type; vinit = v_v_init })

and map_init env x : G.expr =
  match x with
  | EqInit (v1, v2) ->
      let _v1 = map_tok env v1 and v2 = map_initialiser env v2 in
      v2
  | ObjInit v1 ->
      let l, args, r = map_obj_init env v1 in
      (* TODO? if initializer has designator, should make it a Record? *)
      G.Container (G.Array, (l, args |> List.map H.argument_to_expr, r)) |> G.e
  | Bitfield (v1, v2) ->
      let _v1TODO = map_tok env v1 and v2 = map_a_const_expr env v2 in
      v2

and map_obj_init env x : G.argument list bracket =
  match x with
  | Args v1 ->
      let v1 = map_paren env (map_of_list (map_argument env)) v1 in
      v1
  | Inits v1 ->
      let lbrace, xs, rbraces =
        map_brace env (map_of_list (map_initialiser env)) v1
      in
      (lbrace, xs |> List.map G.arg, rbraces)

and map_initialiser env x : G.expr = map_initialiser_bis env x

and map_initialiser_bis env x =
  match x with
  | InitExpr v1 ->
      let v1 = map_expr env v1 in
      v1
  | InitList v1 ->
      (* TODO: should look in xs for either and decide to build an Array
       * or a Dict
       *)
      let l, xs, r = map_brace env (map_of_list (map_initialiser_bis env)) v1 in
      G.Container (G.Array, (l, xs, r)) |> G.e
  | InitDesignators (v1, v2, v3) ->
      let _v1TODO = map_of_list (map_designator env) v1
      and _v2 = map_tok env v2
      and v3 = map_initialiser env v3 in
      v3
  | InitFieldOld (v1, v2, v3) ->
      let _v1TODO = map_ident env v1
      and _v2 = map_tok env v2
      and v3 = map_initialiser env v3 in
      v3
  | InitIndexOld (v1, v2) ->
      let _v1TODO = map_bracket env (map_expr env) v1
      and v2 = map_initialiser env v2 in
      v2

and map_designator env = function
  | DesignatorField (v1, v2) ->
      let _v1 = map_tok env v1 and v2 = map_ident env v2 in
      Left3 v2
  | DesignatorIndex v1 ->
      let _, v1, _ = map_bracket env (map_expr env) v1 in
      Middle3 v1
  | DesignatorRange v1 ->
      let _, v1, _ =
        map_bracket env
          (fun (v1, v2, v3) ->
            let v1 = map_expr env v1
            and _v2 = map_tok env v2
            and v3 = map_expr env v3 in
            (v1, v3))
          v1
      in
      Right3 v1

and map_func_definition env (v1, v2) : G.definition =
  let v1 = map_entity env v1 and v2 = map_function_definition env v2 in
  (v1, FuncDef v2)

and map_function_definition env
    { f_type = v_f_type; f_body = v_f_body; f_specs = v_f_specs } :
    G.function_definition =
  let _v_f_specsTODO = map_of_list (map_specifier env) v_f_specs in
  let fbody, _attrsTODO = map_function_body env v_f_body in
  let fparams, fret = map_functionType env v_f_type in
  { G.fkind = (G.Function, G.fake ""); fparams; frettype = Some fret; fbody }

and map_functionType env x : G.parameter list * G.type_ =
  match x with
  | {
   ft_ret = v_ft_ret;
   ft_params = v_ft_params;
   ft_specs = v_ft_specs;
   ft_const = v_ft_const;
   ft_throw = v_ft_throw;
  } ->
      let _v_ft_throwTODO = map_of_list (map_exn_spec env) v_ft_throw in
      let _v_ft_constTODO = map_of_option (map_tok env) v_ft_const in
      let _v_ft_specsTODO = map_of_list (map_specifier env) v_ft_specs in
      let _, params, _ =
        map_paren env (map_of_list (map_parameter env)) v_ft_params
      in
      let tret = map_type_ env v_ft_ret in
      (params, tret)

and map_parameter env x : G.parameter =
  match x with
  | P v1 ->
      let v1 = map_parameter_classic env v1 in
      G.ParamClassic v1
  | ParamVariadic (v1, v2, v3) ->
      let _v1TODO = map_of_option (map_tok env) v1
      and v2 = map_tok env v2
      and v3 = map_parameter_classic env v3 in
      G.ParamRest (v2, v3)
  | ParamEllipsis v1 ->
      let v1 = map_tok env v1 in
      G.ParamEllipsis v1

and map_parameter_classic env
    {
      p_name = v_p_name;
      p_type = v_p_type;
      p_specs = v_p_specs;
      p_val = v_p_val;
    } : G.parameter_classic =
  let v_p_val =
    map_of_option
      (fun (v1, v2) ->
        let _v1 = map_tok env v1 and v2 = map_expr env v2 in
        v2)
      v_p_val
  in
  let v_p_specs = map_of_list (map_specifier env) v_p_specs in
  let v_p_type = map_type_ env v_p_type in
  let v_p_name = map_of_option (map_ident env) v_p_name in
  {
    G.pname = v_p_name;
    ptype = Some v_p_type;
    pattrs = v_p_specs;
    pdefault = v_p_val;
    pinfo = G.empty_id_info ();
  }

and map_exn_spec env = function
  | ThrowSpec (v1, v2) ->
      let _v1 = map_tok env v1
      and _, v2, _ = map_paren env (map_of_list (map_type_ env)) v2 in
      Left v2
  | Noexcept (v1, v2) ->
      let _v1 = map_tok env v1
      and v2 =
        map_of_option
          (map_paren_skip env (map_of_option (map_a_const_expr env)))
          v2
      in
      Right v2

and map_function_body env x : G.function_body * G.attribute list =
  match x with
  | FBDef v1 ->
      let v1 = map_compound env v1 in
      (G.FBStmt (G.Block v1 |> G.s), [])
  | FBDecl v1 ->
      let v1 = map_sc env v1 in
      (G.FBDecl v1, [])
  | FBZero (v1, v2, v3) ->
      let _v1 = map_tok env v1 and v2 = map_tok env v2 and v3 = map_sc env v3 in
      let attr = G.attr G.Abstract v2 in
      (G.FBDecl v3, [ attr ])
  | FBDefault (v1, v2, v3) ->
      let _v1 = map_tok env v1 and v2 = map_tok env v2 and v3 = map_sc env v3 in
      let attr = G.unhandled_keywordattr ("DefaultedFunction", v2) in
      (G.FBDecl v3, [ attr ])
  | FBDelete (v1, v2, v3) ->
      let _v1 = map_tok env v1 and v2 = map_tok env v2 and v3 = map_sc env v3 in
      let attr = G.unhandled_keywordattr ("DeletedFunction", v2) in
      (G.FBDecl v3, [ attr ])

and map_lambda_definition env (v1, v2) : G.function_definition =
  let _v1TODO = map_bracket env (map_of_list (map_lambda_capture env)) v1
  and v2 = map_function_definition env v2 in
  v2

and map_lambda_capture env = function
  | CaptureEq v1 ->
      let v1 = map_tok env v1 in
      Left v1
  | CaptureRef v1 ->
      let v1 = map_tok env v1 in
      Left v1
  | CaptureOther v1 ->
      let v1 = map_expr env v1 in
      Right v1

and map_enum_definition env
    {
      enum_kind = v_enum_kind;
      enum_name = v_enum_name;
      enum_body = v_enum_body;
    } : G.name option * G.type_definition =
  let _l, v_enum_body, _r =
    map_brace env (map_of_list (map_enum_elem env)) v_enum_body
  in
  let v_enum_name = map_of_option (map_name env) v_enum_name in
  let _v_enum_kindTODO = map_tok env v_enum_kind in
  (v_enum_name, { G.tbody = G.OrType v_enum_body })

and map_enum_elem env { e_name = v_e_name; e_val = v_e_val } =
  let v_e_val =
    map_of_option
      (fun (v1, v2) ->
        let _v1 = map_tok env v1 and v2 = map_a_const_expr env v2 in
        v2)
      v_e_val
  in
  let v_e_name = map_ident env v_e_name in
  G.OrEnum (v_e_name, v_e_val)

and map_class_definition env (v1, v2) : G.name option * G.class_definition =
  let v1 = map_of_option (map_a_class_name env) v1
  and v2 = map_class_definition_bis env v2 in
  (v1, v2)

and map_class_definition_bis env
    { c_kind = v_c_kind; c_inherit = v_c_inherit; c_members = v_c_members } :
    G.class_definition =
  let l, v_c_members, r =
    map_brace env
      (map_of_list (map_sequencable_for_field env (map_class_member env)))
      v_c_members
  in
  let v_c_kind, _attrsTODO = map_class_key env v_c_kind in
  let v_c_inherit = map_of_list (map_base_clause env) v_c_inherit in
  let fields = List.flatten v_c_members |> distribute_access in
  {
    G.ckind = v_c_kind;
    cextends = v_c_inherit;
    cimplements = [];
    cmixins = [];
    cparams = [];
    cbody = (l, fields, r);
  }

and map_class_key env (k, t) =
  let t = map_tok env t in
  match k with
  (* todo: Struct are really just class with public: appended
   * just after, so we should return a function to apply to all
   * members?
   *)
  | Struct -> ((G.Class, t), [ G.attr G.RecordClass t ])
  | Union -> ((G.Class, t), [ G.unhandled_keywordattr ("Union", t) ])
  | Class -> ((G.Class, t), [])

and map_base_clause env
    { i_name = v_i_name; i_virtual = v_i_virtual; i_access = v_i_access } :
    G.class_parent =
  let _v_i_accessTODO =
    map_of_option (map_wrap env (map_access_spec env)) v_i_access
  in
  let _v_i_virtualTODO = map_of_option (map_modifier env) v_i_virtual in
  let v_i_name = map_a_class_name env v_i_name in
  (G.TyN v_i_name |> G.t, None)

and map_class_member env x : (G.field, G.attribute) either list =
  match x with
  | Access (v1, v2) ->
      let v1 = map_wrap env (map_access_spec env) v1 and _v2 = map_tok env v2 in

      (* we will apply access_spec to all that follows (until next Access)
       * in distribute_access() in the caller.
       *)
      [ Right (G.KeywordAttr v1) ]
  | Friend (v1, v2) ->
      let _v1TODO = map_tok env v1 and v2 = map_decl env v2 in
      v2 |> List.map (fun st -> Left (G.FieldStmt st))
  | QualifiedIdInClass (v1, v2) ->
      let v1 = map_name env v1 and v2 = map_sc env v2 in
      let e = G.N v1 |> G.e in
      let st = G.ExprStmt (e, v2) |> G.s in
      [ Left (G.FieldStmt st) ]
  | F v1 ->
      let v1 = map_decl env v1 in
      v1 |> List.map (fun st -> Left (G.FieldStmt st))

and map_template_parameter env x : G.type_parameter =
  match x with
  | TP v1 ->
      let v1 = map_parameter env v1 in
      parameter_to_type_parameter v1
  | TPClass (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_of_option (map_ident env) v2
      and v3 = map_of_option (map_type_ env) v3 in
      todo env (v1, v2, v3)
  | TPVariadic (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_tok env v2
      and v3 = map_of_option (map_ident env) v3 in
      todo env (v1, v2, v3)
  | TPNested (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_template_parameters env v2
      and v3 = map_template_parameter env v3 in
      todo env (v1, v2, v3)

and map_template_parameters env v : G.type_parameter list =
  map_angle env (map_of_list (map_template_parameter env)) v

and map_specifier env x : G.attribute =
  match x with
  | A v1 ->
      let v1 = map_attribute env v1 in
      v1
  | M v1 ->
      let v1 = map_modifier env v1 in
      v1
  | TQ v1 ->
      let v1 = map_qualifier_wrap env v1 in
      v1
  | ST v1 ->
      let v1 = map_storage env v1 in
      v1

and map_attribute env x : G.attribute =
  match x with
  | UnderscoresAttr (v1, v2) ->
      let v1 = map_tok env v1
      and l1, (_l2, xs, _r2), r1 =
        map_paren env (map_paren env (map_of_list (map_argument env))) v2
      in
      let name = H.name_of_id ("__attribute", v1) in
      G.NamedAttr (v1, name, (l1, xs, r1))
  | BracketsAttr v1 ->
      let l, xs, _r = map_bracket env (map_of_list (map_expr env)) v1 in
      G.OtherAttribute (("BracketsAttr", l), xs |> List.map (fun e -> G.E e))
  | DeclSpec (v1, v2) ->
      let v1 = map_tok env v1 and l, id, r = map_paren env (map_ident env) v2 in
      let name = H.name_of_id ("__declspec", v1) in
      let arg = G.Arg (G.N (H.name_of_id id) |> G.e) in
      G.NamedAttr (v1, name, (l, [ arg ], r))

and map_modifier env = function
  | Inline v1 ->
      let v1 = map_tok env v1 in
      G.attr G.Inline v1
  | Virtual v1 ->
      let v1 = map_tok env v1 in
      G.attr G.Abstract v1
  | Final v1 ->
      let v1 = map_tok env v1 in
      G.attr G.Final v1
  | Override v1 ->
      let v1 = map_tok env v1 in
      G.attr G.Override v1
  | MsCall v1 ->
      let v1 = map_wrap env map_of_string v1 in
      G.unhandled_keywordattr v1
  | Explicit (v1, v2) ->
      let v1 = map_tok env v1
      and _v2 = map_of_option (map_paren env (map_expr env)) v2 in
      G.unhandled_keywordattr ("explicit", v1)

and map_access_spec _env = function
  | Public -> G.Public
  | Private -> G.Private
  | Protected -> G.Protected

and map_storage _env (x, t) : G.attribute =
  match x with
  | Auto -> G.unhandled_keywordattr ("auto", t)
  | Static -> G.attr G.Static t
  | Register -> G.unhandled_keywordattr ("register", t)
  | Extern -> G.attr G.Extern t
  | StoInline -> G.attr G.Inline t

and map_pointer_modifier env x : G.attribute =
  match x with
  | Based (v1, v2) ->
      let v1 = map_tok env v1
      and v2 = map_paren env (map_of_list (map_argument env)) v2 in
      let name = H.name_of_id ("__based", v1) in
      G.NamedAttr (v1, name, v2)
  | PtrRestrict v1 ->
      let v1 = map_tok env v1 in
      G.unhandled_keywordattr ("PtrRestrict", v1)
  | Uptr v1 ->
      let v1 = map_tok env v1 in
      G.unhandled_keywordattr ("Uptr", v1)
  | Sptr v1 ->
      let v1 = map_tok env v1 in
      G.unhandled_keywordattr ("Sptr", v1)
  | Unaligned v1 ->
      let v1 = map_tok env v1 in
      G.unhandled_keywordattr ("Unaligned", v1)

and map_using env (v1, v2, v3) : G.stmt =
  let v1 = map_tok env v1
  and v2 = map_using_kind env v2
  and _v3 = map_sc env v3 in
  v2 v1 |> def_or_dir_either_to_stmt

and map_using_kind env x : G.tok -> (G.directive, G.definition) either =
  match x with
  | UsingName v1 -> (
      let v1 = map_name env v1 in
      fun tk ->
        let xs = H.dotted_ident_of_name v1 in
        match List.rev xs with
        | [] -> error tk "Empty name in UsingName"
        | x :: xs ->
            let dots = List.rev xs in
            Left (G.ImportFrom (tk, G.DottedName dots, x, None) |> G.d))
  | UsingNamespace (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_a_ident_name env v2 in
      fun tk ->
        let dots = H.dotted_ident_of_name v2 in
        Left (G.ImportAll (tk, G.DottedName dots, PI.fake_info v1 "") |> G.d)
  | UsingAlias (v1, v2, v3) ->
      fun _tk ->
        let v1 = map_ident env v1
        and _v2 = map_tok env v2
        and v3 = map_type_ env v3 in
        let ent = G.basic_entity v1 in
        let def = G.TypeDef { G.tbody = G.AliasType v3 } in
        Right (ent, def)

and map_cpp_directive env x : (G.directive, G.definition) either =
  match x with
  | Define (v1, v2, v3, v4) ->
      let _v1 = map_tok env v1
      and v2 = map_ident env v2
      and v3 = map_define_kind env v3
      and v4 = map_define_val env v4 in
      let ent = G.basic_entity v2 in
      let def = (ent, G.MacroDef { G.macroparams = v3; macrobody = v4 }) in
      Right def
  | Include (v1, v2) -> (
      let v1 = map_tok env v1 and v2 = map_include_kind env v2 in
      match v2 with
      | Left file ->
          let dir = G.ImportAll (v1, G.FileName file, v1) |> G.d in
          Left dir
      | Right e ->
          let categ = G.TodoK ("IncludeDynamic", v1) in
          let dir = G.OtherDirective (G.OI_Todo, [ categ; G.E e ]) |> G.d in
          Left dir)
  | Undef v1 ->
      let v1 = map_ident env v1 in
      let dir = G.OtherDirective (OI_Undef, [ G.I v1 ]) |> G.d in
      Left dir
  | PragmaAndCo v1 ->
      let v1 = map_tok env v1 in
      let dir = G.Pragma (("PragmaAndCo", v1), []) |> G.d in
      Left dir

and map_define_kind env x : G.ident list =
  match x with
  | DefineVar -> []
  | DefineMacro v1 ->
      let _l, xs, _r = map_paren env (map_of_list (map_ident env)) v1 in
      xs

and map_define_val env = function
  | DefineExpr v1 ->
      let v1 = map_expr env v1 in
      [ G.E v1 ]
  | DefineStmt v1 ->
      let v1 = map_stmt env v1 in
      [ G.S v1 ]
  | DefineType v1 ->
      let v1 = map_type_ env v1 in
      [ G.T v1 ]
  | DefineFunction v1 ->
      let v1 = map_func_definition env v1 in
      [ G.Def v1 ]
  | DefineInit v1 ->
      let v1 = map_initialiser env v1 in
      [ G.E v1 ]
  | DefineDoWhileZero (v1, v2, v3, v4) ->
      let _v1 = map_tok env v1
      and v2 = map_stmt env v2
      and _v3 = map_tok env v3
      and _v4 = map_paren env (map_tok env) v4 in
      [ G.S v2 ]
  | DefinePrintWrapper (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _l, v2, _r = map_paren env (map_expr env) v2
      and v3 = map_name env v3 in
      [ G.Tk v1; G.E v2; G.E (G.N v3 |> G.e) ]
  | DefineEmpty -> []
  | DefineTodo v1 ->
      let v1 = map_todo_category env v1 in
      [ G.TodoK v1 ]

and map_include_kind env = function
  | IncLocal v1 ->
      let v1 = map_wrap env map_of_string v1 in
      Left v1
  | IncSystem v1 ->
      let v1 = map_wrap env map_of_string v1 in
      Left v1
  | IncOther v1 ->
      let v1 = map_a_cppExpr env v1 in
      Right v1

and map_a_cppExpr env v = map_expr env v

(* TODO: ifdef_skipper like in ast_c_build.ml *)
and map_sequencable :
      'a. env -> ('a -> G.stmt list) -> 'a sequencable -> G.stmt list =
 fun env _of_a -> function
  | X v1 ->
      let v1 = _of_a v1 in
      v1
  | CppDirective v1 ->
      let v1 = map_cpp_directive env v1 in
      [ def_or_dir_either_to_stmt v1 ]
  | CppIfdef v1 ->
      let _v1TODO = map_ifdef_directive env v1 in
      []
  | MacroDecl (v1, v2, v3, v4) ->
      let v1 = map_of_list (map_specifier env) v1
      and v2 = map_ident env v2
      and _, xs, _ = map_paren env (map_of_list (map_argument env)) v3
      and v4 = map_tok env v4 in
      let ent = G.basic_entity ~attrs:v1 v2 in
      let def = G.OtherDef (("MacroDecl", snd v2), [ G.Args xs; G.Tk v4 ]) in
      [ G.DefStmt (ent, def) |> G.s ]
  | MacroVar (v1, v2) ->
      let v1 = map_ident env v1 and v2 = map_sc env v2 in
      let ent = G.basic_entity v1 in
      let def = G.OtherDef (("MacroVar", snd v1), [ G.Tk v2 ]) in
      [ G.DefStmt (ent, def) |> G.s ]

(* mostly copy-paste of function above but with different type
 * with the field local helper
 *)
and map_sequencable_for_field :
      'a. env -> ('a -> (G.field, G.attribute) either list) -> 'a sequencable ->
      (G.field, G.attribute) either list =
  let field x = Left (G.FieldStmt x) in
  fun env _of_a -> function
    | X v1 ->
        let v1 = _of_a v1 in
        v1
    | CppDirective v1 ->
        let v1 = map_cpp_directive env v1 in
        [ def_or_dir_either_to_stmt v1 |> field ]
    | CppIfdef v1 ->
        let _v1 = map_ifdef_directive env v1 in
        []
    | MacroDecl (v1, v2, v3, v4) ->
        let v1 = map_of_list (map_specifier env) v1
        and v2 = map_ident env v2
        and _, xs, _ = map_paren env (map_of_list (map_argument env)) v3
        and v4 = map_tok env v4 in
        let ent = G.basic_entity ~attrs:v1 v2 in
        let def = G.OtherDef (("MacroDecl", snd v2), [ G.Args xs; G.Tk v4 ]) in
        [ G.DefStmt (ent, def) |> G.s |> field ]
    | MacroVar (v1, v2) ->
        let v1 = map_ident env v1 and v2 = map_sc env v2 in
        let ent = G.basic_entity v1 in
        let def = G.OtherDef (("MacroVar", snd v1), [ G.Tk v2 ]) in
        [ G.DefStmt (ent, def) |> G.s |> field ]

and map_ifdef_directive env = function
  | Ifdef v1 ->
      let _v1 = map_tok env v1 in
      ()
  | IfdefElse v1 ->
      let _v1 = map_tok env v1 in
      ()
  | IfdefElseif v1 ->
      let _v1 = map_tok env v1 in
      ()
  | IfdefEndif v1 ->
      let _v1 = map_tok env v1 in
      ()

let map_toplevel env v = map_sequencable env (map_stmt_or_decl env) v

let map_program env v : G.program =
  map_of_list (map_toplevel env) v |> List.flatten

let map_any env x : G.any =
  match x with
  | Expr v1 ->
      let v1 = map_expr env v1 in
      G.E v1
  | Stmt v1 ->
      let v1 = map_stmt env v1 in
      G.S v1
  | Stmts v1 ->
      let v1 = map_of_list (map_stmt env) v1 in
      G.Ss v1
  | Toplevel v1 -> (
      let v1 = map_toplevel env v1 in
      match v1 with
      | [ x ] -> G.S x
      | xs -> G.Ss xs)
  | Toplevels v1 ->
      let v1 = map_of_list (map_toplevel env) v1 |> List.flatten in
      G.Ss v1
  | Program v1 ->
      let v1 = map_program env v1 in
      G.Ss v1
  | Cpp v1 ->
      let v1 = map_cpp_directive env v1 in
      G.S (def_or_dir_either_to_stmt v1)
  | Type v1 ->
      let v1 = map_type_ env v1 in
      G.T v1
  | Name v1 ->
      let v1 = map_name env v1 in
      G.E (G.N v1 |> G.e)
  | OneDecl v1 ->
      let v1 = map_onedecl env v1 in
      G.Def v1
  | Init v1 ->
      let v1 = map_initialiser env v1 in
      G.E v1
  | ClassMember v1 ->
      let v1 = map_class_member env v1 in
      G.Flds (distribute_access v1)
  | Constant v1 ->
      let v1 = map_constant env v1 in
      G.E (G.L v1 |> G.e)
  | Argument v1 ->
      let v1 = map_argument env v1 in
      G.Ar v1
  | Parameter v1 ->
      let v1 = map_parameter env v1 in
      G.Pa v1
  | Body v1 ->
      let v1 = map_compound env v1 in
      let st = G.Block v1 |> G.s in
      G.S st
  | Info v1 ->
      let v1 = map_tok env v1 in
      G.Tk v1
  | InfoList v1 ->
      let v1 = map_of_list (map_tok env) v1 in
      G.Anys (v1 |> List.map (fun tk -> G.Tk tk))

(*****************************************************************************)
(* Entry point *)
(*****************************************************************************)
let any x =
  let env = () in
  map_any env x

let program cst =
  let env = () in
  map_program env cst
